Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/toolkit/vbof_v11/vbofdata.cls

Text File | 1996-03-03 | 19KB | 710 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "VBOFDataWrapper"
Attribute VB_Creatable = True
Attribute VB_Exposed = True
Option Explicit

' (c) Copyright 1995 Ken Fitzpatrick
'     All Rights Reserved
'     Cannot be distributed or sold without permission
'
' VBOFDataWrapper is a supplemental GUI
'   Control Wrapper for Microsoft Visual Basic 4.0.
'   It is valid only in conjunction with the
'   following Classes Modules:
'       VBOFCollection
'       VBOFObjectLink
'       VBOFObjectManager

' VBOFDataWrapper is a wrapper class for
'   providing automatic interfacing between a
'   RecordSet VB control and an underlying
'   VBOFCollection

Private pvtVBOFObjectManager As VBOFObjectManager
Private pvtCollection As VBOFCollection
Private pvtDataControl As Variant
Private pvtSupportedTypeNames As String
Private pvtDataControlSupportedTypeNames As String
Private pvtCollectionSupportedTypeNames As String
Private pvtPreviousDataControlActionCode As Long

Public ObjectID As Long

Public Property Get AbsolutePositionObject() As Variant
' Returns the object at the AbsolutionPosition (+ 1)
'   of the underlying RecordSet

    Dim tempLong As Long

    On Local Error Resume Next

    tempLong = AbsolutePosition

    If tempLong >= 0 Then
        Set AbsolutePositionObject = _
            pvtCollection.Item _
                (tempLong + 1)
    Else
        Set AbsolutePositionObject = _
            Nothing
    End If
End Property


Public Property Set AbsolutePositionObject(Object As Variant)
' Sets the AbsolutionPosition (+ 1) of the
'   underlying RecordSet to correspond to the
'   object

    Dim tempLong As Long

    On Local Error Resume Next

    tempLong = _
        pvtCollection.CollectionIndex _
            (Item:=Object)

    If tempLong > 0 Then
        AbsolutePosition = tempLong - 1
    End If
End Property



Public Function CloseRecordSet() As Long
' Closes the underlying RecordSet

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        CloseRecordSet = -1
        Exit Function
    End If

    CloseRecordSet = _
        pvtCollection. _
            pvtCloseRecordSet()
End Function
Public Property Get Clone() As RecordSet
' Returns a cloned RecordSet of the underlying
'   RecordSet object

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        Set Clone = Nothing
        Exit Property
    End If

    Set Clone = _
        pvtCollection.pvtCloneRecordSet()
End Property


Public Property Get Collection() As Variant
' Returns my VBOFCollection object

    Set Collection = pvtCollection
End Property
Public Property Set Collection(Collection As Variant)

    If Collection Is Nothing Then
        Set pvtCollection = Nothing
        Exit Property
    End If

    pvtVerifyCollection _
        Collection:=Collection, _
        Verbose:=True

'    Set pvtCollection = Collection
End Property

Public Property Get DataControl() As Variant
    Set DataControl = pvtDataControl
End Property

Public Property Set DataControl(DataControl As Variant)
    pvtVerifyDataControl _
        DataControl:=DataControl, _
        Verbose:=True
End Property

Public Property Get ObjectManager() As VBOFObjectManager
' Return my reference to the VBOFObjectManager

    Set ObjectManager = pvtVBOFObjectManager
End Property
Public Property Set ObjectManager(anObjectManager As VBOFObjectManager)
' Set my reference to the VBOFObjectManager

    Set pvtVBOFObjectManager = anObjectManager
End Property

Public Function MoveToItem( _
    Optional Item As Variant) As Variant
' Positions the underlying RecordSet to the
'   specifed Item and returns the Item

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        Set MoveToItem = Nothing
        Exit Function
    End If

    Set MoveToItem = _
        pvtCollection. _
            pvtRecordSetPositionToItem _
                    (Item:=Item)
End Function

Public Function MoveToObject( _
    Optional Object As Variant) As Variant
' Positions the underlying RecordSet to the
'   specifed Object and returns the Object

    Me.MoveToItem _
       Item:=Object
End Function

Private Sub pvtRefreshDataControl()
' Set the DataControl.RecordSet to the
'   Collection.RecordSet

    Dim tempLong As Long

    On Local Error Resume Next

    If Not pvtIsFullyInitialized() _
    Then
        Exit Sub
    End If

    tempLong = pvtDataControl.RecordSet.AbsolutePosition
    pvtCollection.RecordSet.AbsolutePosition = tempLong

    Set pvtDataControl.RecordSet = _
        pvtCollection.RecordSet

End Sub

Private Function pvtVerifyDataControl(Optional DataControl As Variant, Optional Verbose As Variant) As Boolean
    pvtVerifyDataControl = _
        ObjectManager. _
            pvtWrapperVerifyControl( _
                Control:=DataControl, _
                pvtControl:=pvtDataControl, _
                Verbose:=Verbose)
End Function

Private Function pvtVerifyCollection(Optional Collection As Variant, Optional Verbose As Variant) As Boolean
    pvtVerifyCollection = _
        ObjectManager. _
            pvtWrapperVerifyCollection( _
                Collection:=Collection, _
                pvtCollection:=pvtCollection, _
                Verbose:=Verbose, _
                WrapperName:="Data")
End Function


Private Function pvtErrorMessage(Optional ErrorMessage As Variant) As Long
    pvtErrorMessage = _
        pvtVBOFObjectManager.DisplayErrorMessage _
            (ErrorMessage)
End Function
Private Function pvtIsFullyInitialized(Optional Collection As Variant, Optional DataControl As Variant, Optional Verbose As Variant) As Boolean

    If Not pvtVerifyCollection( _
        Collection:=Collection, _
        Verbose:=Verbose) _
    Then
        pvtIsFullyInitialized = False
        Exit Function
    End If

    If Not pvtVerifyDataControl( _
        DataControl:=DataControl, _
        Verbose:=Verbose) _
    Then
        pvtIsFullyInitialized = False
        Exit Function
    End If

    pvtIsFullyInitialized = True
End Function


Private Function pvtUseDataControl(Optional DataControlParm As Variant, Optional Verbose As Variant) As Variant
    Set pvtUseDataControl = _
        ObjectManager. _
            pvtWrapperUseControl( _
                ControlParm:=DataControlParm, _
                pvtControl:=pvtDataControl, _
                SupportedNames:=pvtDataControlSupportedTypeNames, _
                Verbose:=Verbose, _
                WrapperName:="Data")
End Function

Private Function pvtUseCollection(Optional CollectionParm As Variant, Optional Verbose As Variant) As Variant
    Set pvtUseCollection = _
        ObjectManager. _
            pvtWrapperUseCollection( _
                CollectionParm:=CollectionParm, _
                pvtCollection:=pvtCollection, _
                Verbose:=Verbose, _
                WrapperName:="Data")
End Function


Public Function Rebind( _
    Optional Collection As Variant, _
    Optional DataControl As Variant) As Variant
' Rebinds the Wrapper to a Collection or DataControl
'   after having changed the assignment of either.
'   For example, in the following scenario, the
'   VBOFDataWrapper must be rebound because
'   the VBOFCollection has been significantly altered:
'
'   Dim pvtAddresses as VBOFCollection
'   Dim pvtPerson as Person
'   Dim MyDataWrapper as VBOFDataWrapper
'   Set MyDataWrapper = _
'       ObjectManager.NewVBOFDataWrapper ( _
'           Collection:=pvtAddresses, _
'           DataControl:=MyDataControl)
'
' the following line alters the state of the data
' in-effect at the time of the above binding
'   Set pvtAddresses = pvtPerson.Addresses
' rebind the Wrapper
'   MyDataWrapper.Rebind _
'           Collection:=pvtAddresses

' bullet-proofing
    If Not IsMissing(Collection) Then
        If TypeName(Collection) <> _
            "VBOFCollection" _
        Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.Rebind' method because the 'Collection:=' parameter is not a VBOFCollection."
            Rebind = False
            Exit Function
        End If
    End If
    If Not IsMissing(DataControl) Then
        If InStr(pvtDataControlSupportedTypeNames, TypeName(pvtDataControl)) = 0 Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.Rebind' method because the 'DataControl:=' parameter is not a Visual Basic DataControl control.  Please use a VBOF Wrapper for the " & TypeName(DataControl) & " control (or request the development of one.)"
            Rebind = False
            Exit Function
        End If
    End If
    If Not pvtIsFullyInitialized( _
        Collection:=Collection, _
        DataControl:=DataControl, _
        Verbose:=False) _
    Then
        Rebind = False
        Exit Function
    End If

    pvtRefreshDataControl

    Rebind = True
End Function

Public Property Get RecordSet() As RecordSet
' Returns a DataControl-ready RecordSet object
'   which pertains to the collection of objects
'   instantiated and contained within this
'   VBOFCollection

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        Set RecordSet = Nothing
        Exit Property
    End If

    Set RecordSet = _
        pvtCollection.RecordSet
End Property

Public Property Get AbsolutePosition() As Long
' Pass-thru to pvtRecordSetMoveToRecordNumber

    On Local Error Resume Next

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        AbsolutePosition = -1
        Exit Property
    End If

    AbsolutePosition = _
        pvtDataControl. _
            RecordSet.AbsolutePosition
End Property

Public Property Let AbsolutePosition(RecordNumber As Long)
' Pass-thru to pvtRecordSetMoveToRecordNumber

    On Local Error Resume Next

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        Exit Property
    End If

    pvtDataControl. _
        RecordSet.AbsolutePosition = _
            RecordNumber
End Property

Public Property Get EOF() As Boolean
' Returns a boolean, based on whether or not the
' underlying RecordSet is positioned at EOF

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        EOF = False
        Exit Property
    End If

    EOF = _
        pvtCollection. _
            pvtRecordSetEOF
End Property
Public Function FindFirst( _
    Optional SearchCriteria As Variant) As Variant
' Searches the underlying RecordSet for the first
'   record meeting the specified criteria
'   and returns the object for that row

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        Set FindFirst = Nothing
        Exit Function
    End If

    Set FindFirst = _
        pvtCollection. _
            pvtRecordSetFindFirst _
                (SearchCriteria:=SearchCriteria)
End Function

Public Function FindLast( _
    Optional SearchCriteria As Variant) As Variant
' Searches the underlying RecordSet for the last
'   record meeting the specified criteria
'   and returns the object for that row

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        Set FindLast = Nothing
        Exit Function
    End If

    Set FindLast = _
        pvtCollection. _
            pvtRecordSetFindLast _
                (SearchCriteria:=SearchCriteria)
End Function

Public Function FindPrevious( _
    Optional SearchCriteria As Variant) As Variant
' Searches the underlying RecordSet for the previous
'   record meeting the specified criteria
'   and returns the object for that row

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        Set FindPrevious = Nothing
        Exit Function
    End If

    Set FindPrevious = _
        pvtCollection. _
            pvtRecordSetFindPrevious _
                (SearchCriteria:=SearchCriteria)
End Function

Public Function FindNext( _
    Optional SearchCriteria As Variant) As Variant
' Searches the underlying RecordSet for the next
'   record meeting the specified criteria
'   and returns the object for that row

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        Set FindNext = Nothing
        Exit Function
    End If

    Set FindNext = _
        pvtCollection. _
            pvtRecordSetFindNext _
                (SearchCriteria:=SearchCriteria)
End Function

Public Function MoveFirst() As Variant
' Moves the underlying RecordSet to the first record
'   and returns the object for that row

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        Set MoveFirst = Nothing
        Exit Function
    End If

    Set MoveFirst = _
        pvtCollection. _
            pvtRecordSetMoveFirst
End Function

Public Function MoveLast() As Variant
' Moves the underlying RecordSet to the Last record
'   and returns the object for that row

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        Set MoveLast = Nothing
        Exit Function
    End If

    Set MoveLast = _
        pvtCollection. _
            pvtRecordSetMoveLast
End Function
Public Function MoveToRecordNumber( _
    Optional RecordNumber As Variant) As Variant
' Moves the underlying RecordSet to the specified
'   record (by number) and returns the object for
'   that row

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        Set MoveToRecordNumber = Nothing
        Exit Function
    End If

    Set MoveToRecordNumber = _
        pvtCollection. _
            pvtRecordSetMoveToRecordNumber _
                (RecordNumber:=RecordNumber)
End Function

Public Property Get RecordCount() As Long
' Returns the RecordCount property of the
' underlying RecordSet

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        RecordCount = -1
        Exit Property
    End If

    RecordCount = _
        pvtCollection. _
            pvtRecordSetRecordCount()
End Property

Public Function Refresh( _
    Optional DisplayOnly As Variant) As RecordSet
' Refresh the DataControl

' Pass thru to pvtRefreshRecordSet()

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        Set Refresh = Nothing
        Exit Function
    End If

    pvtRefreshDataControl

    If Not IsMissing(DisplayOnly) Then
        If DisplayOnly Then
            Set Refresh = _
                pvtCollection.RecordSet
        Else
            Set Refresh = _
                pvtCollection.pvtRecordSetRefresh
        End If
    Else
        Set Refresh = _
            pvtCollection.pvtRecordSetRefresh
    End If
End Function

Public Function Sort( _
    Optional SortField As Variant, _
    Optional SortOrder As Variant) As Boolean
' Sorts the objects in the underlying
'   VBOFCollection according to the field
'   referenced in SortField:= and the sort
'   order referenced in SortOrder:=
' For additional information, see the VBOF User's
'   Guide
' Programming example:
'   MyWrapper.Sort _
'       SortField:="FirstName", _
'       SortOrder:="ASC"

    Sort = _
        ObjectManager.pvtWrapperSort( _
            Wrapper:=Me, _
            SortField:=SortField, _
            SortOrder:=SortOrder)
End Function

Public Function Unbind() As Boolean

    Set pvtCollection = Nothing
    Set pvtDataControl = Nothing
    Set pvtVBOFObjectManager = Nothing

End Function


Public Property Get BOF() As Boolean
' Returns a boolean, based on whether or not the
' underlying RecordSet is positioned at BOF

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        BOF = False
        Exit Property
    End If

    BOF = _
        pvtCollection. _
            pvtRecordSetBOF
End Property



Public Function Validate(Action As Integer, Save As Integer, Optional Sample As Variant, Optional Parent As Variant) As Variant
' NOT CURRENTLY SUPPORTED
' Manages the Data1_Validate event procedure for
'   the bound Data control
'
' Programming example:
'   Private Sub Data1_Validate(Action As Integer, Save As Integer)
'       pvtPersonsDataWrapper. _
'            Validate _
'                Action:=Action, _
'                Save:=Save

Exit Function
    Dim tempActionCode As Long

    On Local Error Resume Next

' make sure the Action is one that is handled
    If Action = vbDataActionUpdate Then
        If pvtPreviousDataControlActionCode = vbDataActionAddNew Then
            tempActionCode = vbDataActionAddNew
        Else
            tempActionCode = vbDataActionUpdate
        End If
    ElseIf Action = vbDataActionDelete Then
        Action = vbDataActionDelete
    Else
        pvtPreviousDataControlActionCode = Action
        Set Validate = Nothing
        Exit Function
    End If

' bullet-proofing
    If Not pvtIsFullyInitialized _
        (Verbose:=True) _
    Then
        Set FindPrevious = Nothing
        Exit Function
    End If
    If IsMissing(Action) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.Validate' method because the 'Action:=' parameter is missing."
        Set Validate = Nothing
        Exit Function
    End If
    If IsMissing(Save) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.Validate' method because the 'Save:=' parameter is missing."
        Set Validate = Nothing
        Exit Function
    End If

    Set Validate = _
        pvtCollection. _
            pvtDataValidate( _
                DataControl:=pvtDataControl, _
                Action:=tempActionCode, _
                Save:=Save, _
                Sample:=Sample, _
                Parent:=Parent)

    pvtCollection.Refresh
    pvtPreviousDataControlActionCode = Action
End Function

Private Sub Class_Initialize()

    pvtSupportedTypeNames = _
        "RecordSet DynaSet SnapShot"
    pvtDataControlSupportedTypeNames = _
        "Data"
    pvtCollectionSupportedTypeNames = _
        "VBOFCollection"

    Set pvtDataControl = Nothing
End Sub


Private Sub Class_Terminate()
    If Not ObjectManager Is Nothing Then

' unregister the wrapper from the Form
'       ObjectManager.pvtUnRegisterWrapperUnderForm _
            Form:=Me.Form, _
            Wrapper:=Me

        ObjectManager.TerminateObject _
            Object:=Me
    End If
End Sub